Introducción

Se está interesado en estudiar el comportamiento del tiempo hasta que un cliente deja de serlo. Un estudio recabó información de 7043 clientes de una empresa.

A continuación se presentará un reporte que muestra el procedimiento estadístico realizado hasta determinar un modelo de Cox validado para mostrar una solución al problema.

Los Datos

Cada fila representa un cliente, cada columna contiene los atributos del cliente descritos en el diccionario.

El conjunto de datos incluye información a cerca de:

Clientes que se fueron en el último mes: la columna se llama ‘Churn’.
Servicios a los que se ha suscrito cada cliente: teléfono, varias líneas, Internet, seguridad en línea, respaldo en línea, protección de dispositivos, soporte técnico y transmisión de TV y películas.
Información de la cuenta del cliente: cuánto tiempo ha sido cliente, contrato, método de pago, facturación electrónica, cargos mensuales y cargos totales.
Información demográfica sobre los clientes: sexo, rango de edad y si tienen socios y dependientes.

Análisis de Supervivencia

En cualquier grupo de clientes lo suficientemente grande como Telco, habrá personas que tengan las mismas características. Algunos de ellos abandonarán y otros no, y lo que idealmente le gustaría saber a las empresas de telecomunicaciones es la probabilidad de abandono de cada grupo. Esto es lo que proporciona, por ejemplo, la regresión logística. Pero no está claro para qué escala de tiempo está proporcioando esta probabilidad de abandono. Por lo tanto, se realizó un análisis de supervivencia para este propósito.

Obtención y Preparación de los Datos

Los datos se obtienen de de un archivo csv proporcioando. Son 21 variables que contiene el conjunto de datos, 18 tipo factor incluyendo el identificador que es único y 3 tipo numérica.

kable(head(data[,1:8],3))

customerID	gender	Partner	Dependents	tenure	PhoneService	MultipleLines
7590-VHVEG	Female	Yes	No	1	No	No phone service
5575-GNVDE	Male	No	No	34	Yes	No
3668-QPYBK	Male	No	No	2	Yes	No

kable(head(data[,9:14],3))

InternetService	OnlineSecurity	OnlineBackup	DeviceProtection	TechSupport	StreamingTV
DSL	No	Yes	No	No	No
DSL	Yes	No	Yes	No	No
DSL	Yes	Yes	No	No	No

kable(head(data[,15:21],3))

StreamingMovies	Contract	PaperlessBilling	PaymentMethod	MonthlyCharges	TotalCharges	Churn
No	Month-to-month	Yes	Electronic check	29.85	29.85	No
No	One year	No	Mailed check	56.95	1889.50	No
No	Month-to-month	Yes	Mailed check	53.85	108.15	Yes

El conjunto de datos ya vienen en formato ‘tidy data’ y no tiene valores faltantes a excepción de 11 valores de la columna de cargos totales, esto se debe a que el número de meses que el cliente ha permanecido en la empresa(tenure) es de 0. Por lo que se les asignó el valor 0.

# El resumen de las personas que poseen servicio de internet o servicio de teléfono es:
data$has_InternetService <- ifelse(data$InternetService != "No", "Yes", "No")
data$has_InternetService <- as.factor(data$has_InternetService)

resumen <- data %>% count(PhoneService, has_InternetService)
resumen$porcentaje <- paste(round((resumen$n/7035)*100,2),"%",sep = )

kable(resumen)

PhoneService	has_InternetService	n	porcentaje
No	Yes	682	9.69 %
Yes	No	1526	21.69 %
Yes	Yes	4835	68.73 %

Para la construcción del modelo se necesita que las variables tipo factor tengan la característica de ser variables indicadoras. Es decir, para integrar un factor con a posibles valores en el modelo se necesitan a-1 variables indicadoras. Para esto se creó otra tabla sin alterar las variables numéricas y para las 18 variables tipo factor se hicieron a-1 indicadoras donde a son los niveles que toma la variable tipo factor.

Quedó una tabla de 29 variables; el identificador único, 25 variables tipo indicadora y 3 tipo numérica, incluyendo la variable tenure. Por cuestiones de espacio, sólo se muestra una parte de la tabla.

data$gender_d <- ifelse(data$gender != "Male", 1,0 )
data$Partner_d <- ifelse(data$Partner == "Yes", 1,0 )
data$Dependents_d <- ifelse(data$Dependents == "Yes", 1,0 )
data$PaperlessBilling_d <- ifelse(data$PaperlessBilling == "Yes", 1,0 )
data$PhoneService_d <- ifelse(data$PhoneService == "Yes", 1,0 )
data$MultipleLines_d <- ifelse(data$MultipleLines == "Yes", 1,0 )
data$OnlineSecurity_d <- ifelse(data$OnlineSecurity == "Yes", 1,0 )
data$OnlineBackup_d <- ifelse(data$OnlineBackup == "Yes", 1,0 )
data$DeviceProtection_d <- ifelse(data$DeviceProtection == "Yes", 1,0 )
data$TechSupport_d <- ifelse(data$TechSupport == "Yes", 1,0 )
data$StreamingTV_d <- ifelse(data$StreamingTV == "Yes", 1,0 )
data$StreamingMovies_d <- ifelse(data$StreamingMovies == "Yes", 1,0 )
data$has_InternetService_d <- ifelse(data$InternetService != "No", 1, 0)

data_tres_levels <- data %>% 
        select(InternetService,Contract,PaymentMethod)

data_tres_levels_d <-dummy_cols(data_tres_levels)

data_tres_levels_d<- data_tres_levels_d %>% 
                        select(-c(InternetService,Contract,PaymentMethod))

attach(data)
data_final <- data.frame(customerID,gender_d,SeniorCitizen,Partner_d,Dependents_d,tenure,
                         PaperlessBilling_d,PhoneService_d,MultipleLines_d,
                         OnlineSecurity_d,OnlineBackup_d,DeviceProtection_d,
                         TechSupport_d,StreamingTV_d,StreamingMovies_d,has_InternetService_d,
                         data_tres_levels_d,MonthlyCharges,TotalCharges,Churn)

kable(head(data_final[,c(1,25:27)]))

customerID	PaymentMethod_Electronic.check	PaymentMethod_Mailed.check	MonthlyCharges
7590-VHVEG	1	0	29.85
5575-GNVDE	0	1	56.95
3668-QPYBK	0	1	53.85
7795-CFOCW	0	0	42.30
9237-HQITU	1	0	70.70
9305-CDSKC	1	0	99.65

Análisis de Supervivencia: Covariables que afectan el tiempo de Vida

Antes de realizar un análisis más detallado, veamos la función de supervivencia estimada por el método de Kaplan-Meier.

Para esto, definimos las variables de interés para el tiempo y la censura. Para este caso tenure es la variable tiempo,que el número de meses que un cliente se ha quedado en la compañía y la variable censura es churn, que es un indicador si el cliente se fue en el último mes o no.

data$Churn <- ifelse(data$Churn=='Yes',1,0 )
data_surv <- Surv(data$tenure, data$Churn)

plot(data_surv, xlab="Semanas", ylab="Función de supervivencia", main="Función de supervivencia Kaplan-Meier", col=1:3)

La gráfica anterior nos da una intuición básica a cerca de los clientes.

La rotación es relativamente baja. Después de 20 meses, la probabilidad de que un cliente no cancele el servicio es ligeramente superior al 80% e incluso después de 72 meses, la probabilidad de que la empresa retenga a uno de sus clientes es del 60%.

Inferencias

Se harán las gráficas de las curvas de supervivencia para las covariables género y si es jubilado y las pruebas de hipótesis para determinar si las funciones de supervivencia de las covariables género y jubilados son iguales, es decir, vamos a determinar si dichas variables influyen o no en el comportamiento del tiempo de la vida para que un cliente abandone o no la empresa.

Las pruebas son las siguientes,para las j subpoblaciones, la hipótesis nula es si las subpoblaciones tienen la misma función de supervivencia y la alternativa es que si existe al menos una subpoblación cuya función de supervivencia no es igual a las demás.En términos de prueba de hipótesis:

fit <- survfit(data_surv ~ gender_d, data = data)
ggsurvplot(fit, data = data, 
           pval = TRUE, 
           conf.int = TRUE,
           )

Las curvas de Supervivencia parecen similares y como el p-valor es mayor a el nivel de significancia 0.05 (0.47), la evidencia no es suficiente para rechazar la hipótesis nula, es decir, la variable género parece no influir en el tiempo de vida en el que una persona es cliente hasta que deja de serlo.

fit <- survfit(data_surv ~ SeniorCitizen, data = data)
ggsurvplot(fit, data = data, 
           pval = TRUE, 
           conf.int = TRUE,
           )

Las curvas de Supervivencia parecen diferentes y como el p-valor es menor a el nivel de significancia 0.05 (<0.0001), la evidencia es suficiente para rechazar la hipótesis nula, es decir, hay evidencia para afirmar que si una persona es jubilada, este factor, influye en el tiempo de vida en el que una persona es cliente hasta que dejan de serlo.

De esta forma es posible graficar la función de supervivencia para cada covariable. Con la misma prueba de hipótesis, se verifica si estas tienen un impacto en el tiempo de vida.

data_r <- data[,c(c(2:5),c(7:18))]

a<-list()
for (i in 1:16) {
        
        a[[i]]<-survdiff(data_surv ~ data_r[,i], data = data_r, rho = 1)
}

print(a)

## [[1]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
## 
##                       N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=Female 3488      808      791     0.341     0.793
## data_r[, i]=Male   3555      793      809     0.334     0.793
## 
##  Chisq= 0.8  on 1 degrees of freedom, p= 0.4 
## 
## [[2]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
## 
##                  N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=0 5901     1202     1335      13.4      95.4
## data_r[, i]=1 1142      399      265      67.7      95.4
## 
##  Chisq= 95.4  on 1 degrees of freedom, p= <2e-16 
## 
## [[3]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
## 
##                    N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=No  3641     1060      680       212       443
## data_r[, i]=Yes 3402      540      920       157       443
## 
##  Chisq= 444  on 1 degrees of freedom, p= <2e-16 
## 
## [[4]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
## 
##                    N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=No  4933     1328     1063        66       233
## data_r[, i]=Yes 2110      272      537       131       233
## 
##  Chisq= 233  on 1 degrees of freedom, p= <2e-16 
## 
## [[5]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
## 
##                    N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=No   682      148      153     0.171     0.221
## data_r[, i]=Yes 6361     1452     1447     0.018     0.221
## 
##  Chisq= 0.2  on 1 degrees of freedom, p= 0.6 
## 
## [[6]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
## 
##                                 N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=No               3390      765      644    22.370    44.603
## data_r[, i]=No phone service  682      148      153     0.171     0.221
## data_r[, i]=Yes              2971      688      803    16.466    39.589
## 
##  Chisq= 46.6  on 2 degrees of freedom, p= 8e-11 
## 
## [[7]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
## 
##                            N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=DSL         2421      404      554      40.7      73.3
## data_r[, i]=Fiber optic 3096     1091      712     202.3     428.2
## data_r[, i]=No          1526      105      334     157.3     233.1
## 
##  Chisq= 470  on 2 degrees of freedom, p= <2e-16 
## 
## [[8]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
## 
##                                    N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=No                  3498     1261      694       465       974
## data_r[, i]=No internet service 1526      105      334       157       233
## data_r[, i]=Yes                 2019      234      573       200       377
## 
##  Chisq= 975  on 2 degrees of freedom, p= <2e-16 
## 
## [[9]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
## 
##                                    N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=No                  3088     1082      584       426       796
## data_r[, i]=No internet service 1526      105      334       157       233
## data_r[, i]=Yes                 2429      413      683       106       224
## 
##  Chisq= 815  on 2 degrees of freedom, p= <2e-16 
## 
## [[10]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
## 
##                                    N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=No                  3095     1061      584     390.2       730
## data_r[, i]=No internet service 1526      105      334     157.3       233
## data_r[, i]=Yes                 2422      434      682      90.3       190
## 
##  Chisq= 753  on 2 degrees of freedom, p= <2e-16 
## 
## [[11]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
## 
##                                    N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=No                  3473     1249      688       457       952
## data_r[, i]=No internet service 1526      105      334       157       233
## data_r[, i]=Yes                 2044      246      578       190       360
## 
##  Chisq= 954  on 2 degrees of freedom, p= <2e-16 
## 
## [[12]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
## 
##                                    N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=No                  2810      836      545    155.16     277.5
## data_r[, i]=No internet service 1526      105      334    157.32     233.1
## data_r[, i]=Yes                 2707      659      721      5.27      11.5
## 
##  Chisq= 371  on 2 degrees of freedom, p= <2e-16 
## 
## [[13]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
## 
##                                    N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=No                  2785      833      537    163.80     290.7
## data_r[, i]=No internet service 1526      105      334    157.32     233.1
## data_r[, i]=Yes                 2732      662      729      6.22      13.6
## 
##  Chisq= 382  on 2 degrees of freedom, p= <2e-16 
## 
## [[14]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
## 
##                               N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=Month-to-month 3875   1448.6      637      1035      2166
## data_r[, i]=One year       1473    119.9      400       196       311
## data_r[, i]=Two year       1695     31.6      563       502       997
## 
##  Chisq= 2203  on 2 degrees of freedom, p= <2e-16 
## 
## [[15]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
## 
##                    N Observed Expected (O-E)^2/E (O-E)^2/V
## data_r[, i]=No  2872      409      649      88.7       175
## data_r[, i]=Yes 4171     1191      951      60.6       175
## 
##  Chisq= 175  on 1 degrees of freedom, p= <2e-16 
## 
## [[16]]
## Call:
## survdiff(formula = data_surv ~ data_r[, i], data = data_r, rho = 1)
## 
##                                          N Observed Expected (O-E)^2/E
## data_r[, i]=Bank transfer (automatic) 1544      208      429   113.425
## data_r[, i]=Credit card (automatic)   1522      186      420   130.997
## data_r[, i]=Electronic check          2365      923      462   460.114
## data_r[, i]=Mailed check              1612      283      289     0.109
##                                       (O-E)^2/V
## data_r[, i]=Bank transfer (automatic)   185.951
## data_r[, i]=Credit card (automatic)     212.994
## data_r[, i]=Electronic check            759.383
## data_r[, i]=Mailed check                  0.156
## 
##  Chisq= 839  on 3 degrees of freedom, p= <2e-16

#No se puede guardar el pvalor para ponerlo en otro vector, etc.

Las covariables que no rechazan la hipótesis nula son: PhoneService y Gender. Es decir, para estas dos variables la evidencia no es suficiente para rechazar la hipótesis nula, o sea, las variables Gender y PhoneService no influyen en el tiempo de vida en el que una persona es cliente hasta que deja de serlo.

Ya que para las demás variables su prescencia influye en el tiempo de vida, determinamos las subpoblaciones para las variables que no son dicotómicas que son: InternetService, Contract y PaymentMethod con la prueba de comparaciones múltiples de Peto y Peto. La hipótesis nula es que las subpoblaciones son iguales y la alternativa es que existe no lo son. En otras palabras, si no se rechaza la hipótesis nula entre dos comparaciones, es posible juntar las dos subpoblaciones en una subpoblación. En términos de prueba de hipótesis es:

pairwise_survdiff(Surv(tenure,Churn) ~ InternetService, data = data, p.adjust.method = "bonferroni",   rho = 1)

## 
##  Pairwise comparisons using Peto & Peto test 
## 
## data:  data and InternetService 
## 
##             DSL    Fiber optic
## Fiber optic <2e-16 -          
## No          <2e-16 <2e-16     
## 
## P value adjustment method: bonferroni

pairwise_survdiff(Surv(tenure,Churn) ~ Contract, data = data, p.adjust.method = "bonferroni",   rho = 1)

## 
##  Pairwise comparisons using Peto & Peto test 
## 
## data:  data and Contract 
## 
##          Month-to-month One year
## One year <2e-16         -       
## Two year <2e-16         <2e-16  
## 
## P value adjustment method: bonferroni

pairwise_survdiff(Surv(tenure,Churn) ~ PaymentMethod, data = data, p.adjust.method = "bonferroni",   rho = 1)

## 
##  Pairwise comparisons using Peto & Peto test 
## 
## data:  data and PaymentMethod 
## 
##                         Bank transfer (automatic) Credit card (automatic)
## Credit card (automatic) 1                         -                      
## Electronic check        < 2e-16                   < 2e-16                
## Mailed check            7.6e-14                   < 2e-16                
##                         Electronic check
## Credit card (automatic) -               
## Electronic check        -               
## Mailed check            < 2e-16         
## 
## P value adjustment method: bonferroni

La prueba Peto-Peto solamente nos permitió juntar los factores de Credit card y Bank transfer de la covariable PaymentMethod en una sola subpoblación. Las variables dicotómicas que se crearon en la sección pasada se juntaran en una sola que se llama PaymentMethod_BankTransfer_CreditcCard.

data_final$PaymentMethod_BankTransfer_CreditcCard<-data_final$PaymentMethod_Bank.transfer..automatic.+data_final$PaymentMethod_Credit.card..automatic.

Estas observaciones son útiles para que la empresa de telecomunicaciones Telco comprenda la agregación, la tendencia y las posibles percepciones comerciales.

Construcción del modelo: Modelo de Riesgos de Cox

El modelo de Cox trata de ajustar los coeficientes de la función de riesgo utilizando un método de verosimilitud parcial. La ventaja de la regresión de riesgos proporcionales de Cox es que los modelos de supervivencia se pueden ajustar sin el supuesto de distribución.

Para empezar, se ajustó un modelo de cox para todas las covariables.

Para esto, se plantea la prueba de hipótesis para la significancia del modelo y la prueba de hipótesis para considerar variables en el modelo dado que ya las demás ya están consideradas.

Para la prueba de hipótesis para la significancia del modelo, la hipótesis nula es que nunguna variables es significativa y la alternativa es que al menos una variable lo es. En términos de pruebas de hipótesis:

data.model.fit <- coxph(data_surv ~ gender_d+SeniorCitizen+Partner_d+Dependents_d+PaperlessBilling_d+PhoneService_d+MultipleLines_d+OnlineSecurity_d+OnlineBackup_d+DeviceProtection_d+TechSupport_d+StreamingTV_d+StreamingMovies_d+InternetService_DSL+InternetService_Fiber.optic+Contract_One.year+Contract_Two.year+PaymentMethod_BankTransfer_CreditcCard+PaymentMethod_Electronic.check+MonthlyCharges+TotalCharges,
data = data_final, method = "breslow",na.action = na.exclude)



resumen <- summary(data.model.fit)

kable(as.data.frame(resumen$logtest))

	resumen$logtest
test	5789.037
df	21.000
pvalue	0.000

Como el p-valor de la prueba de hipótesis para la significancia del modelo es menor a 0.05, dada la muestra, no hay evidencia para afirmar que todas las variables no deban ser consideradas en el modelo.

Para la significancia de las covariables de manera individual si estas deben estar en el modelo dado que las otras ya están las hipótesis nula es: el coeficiente de la covariables es 0 y la alternativa es, el coeficiente de la covariable es distinto de 0. En términos de prueba de hipótesis, es:

resumdataframe <- as.data.frame(resumen$coefficients)
kable(resumdataframe[,c(2,3,5)])

	exp(coef)	se(coef)	Pr(>\|z\|)
gender_d	1.0377914	0.0465534	0.4255536
SeniorCitizen	1.0320077	0.0565893	0.5776982
Partner_d	0.8455658	0.0550536	0.0023113
Dependents_d	0.9060403	0.0696607	0.1566413
PaperlessBilling_d	1.1516705	0.0565561	0.0125294
PhoneService_d	2.1882107	0.4746194	0.0989592
MultipleLines_d	1.0935375	0.1260201	0.4779817
OnlineSecurity_d	0.8147341	0.1330451	0.1235531
OnlineBackup_d	0.9550748	0.1279993	0.7195141
DeviceProtection_d	1.0975193	0.1267931	0.4630143
TechSupport_d	0.9325119	0.1323960	0.5976660
StreamingTV_d	1.3151177	0.2357189	0.2451996
StreamingMovies_d	1.3239701	0.2359078	0.2342053
InternetService_DSL	9.1044044	0.5957235	0.0002092
InternetService_Fiber.optic	23.8676318	1.1604995	0.0062616
Contract_One.year	0.2810844	0.1004983	0.0000000
Contract_Two.year	0.0249681	0.2007550	0.0000000
PaymentMethod_BankTransfer_CreditcCard	0.6061603	0.0755975	0.0000000
PaymentMethod_Electronic.check	0.8806490	0.0696927	0.0682029
MonthlyCharges	1.0129440	0.0230112	0.5762298
TotalCharges	0.9984627	0.0000399	0.0000000

#Quitaste InternetService_No, PaymentMethod_Mailed.check, Contract_Month.to.month

Las resumen estadístico anterior indican la importancia de las covariables en la predicción del riesgo de abandono.

En la regresión anterior, la salida exp(coef) se interpreta como el factor de proporcionalidad entre el riesgo $h(t;X )$ y el riesgo base $h_0$, siendo 1.00 neutral.
Las covariables Partner, PaperlessBilling, Internet Service (DSL o Fiber Optic), contract (1 year & 2 year), Payment Method (Bank Transfer y Credit Card) y Total Charges tienen un p-valor menor a 0.05 y así, son significativas en el modelo, es decir, deben ser consideradas en el modelo ya que las otras están, por tanto, tienen un rol importante en la predicción de la deserción, mientras que todas las demás covariables no son significativas.

Selección del Modelo

Existen varias estrategias para seleccionar el modelo. A continuación se presentará un método interactivo, que es un método general que consiste en 4 pasos.

Paso 1

Se ajusta un modelo para cada una las covariables por separado. Se prueba pa significancia de cada uno de ellos y se consideran como posibles candidatos aquellos que resulten significativos.

data_ind <- data.frame(gender_d,SeniorCitizen,Partner_d,Dependents_d,
                         PaperlessBilling_d,PhoneService_d,MultipleLines_d,
                         OnlineSecurity_d,OnlineBackup_d,DeviceProtection_d,
                         TechSupport_d,StreamingTV_d,StreamingMovies_d,                        data_tres_levels_d,data_final$PaymentMethod_BankTransfer_CreditcCard,MonthlyCharges,TotalCharges)

exp.coef.ind<-numeric(0)
se.coef.ind<-numeric(0)
p.val.ind<-numeric(0)
resumen.ind<-list()
for (i in 1:26) {
        
resumen.ind[[i]] <- summary(coxph(data_surv ~ data_ind[,i],data = data_ind, method = "breslow",na.action = na.exclude))

exp.coef.ind[i]<-resumen.ind[[i]]$coefficients[,2]
se.coef.ind[i]<-resumen.ind[[i]]$coefficients[,3]
p.val.ind[i]<-resumen.ind[[i]]$coefficients[,5]

}

conclsig<-ifelse(p.val.ind < 0.05, "Significativa", "No significativa")
resumen.ind<-data.frame(colnames(data_ind),exp.coef.ind,p.val.ind,conclsig)

colnames(resumen.ind)<-c("Covariable","exp(coef)","se(coef)","p-value")

kable(resumen.ind)

Covariable	exp(coef)	se(coef)	p-value
gender_d	1.0338046	0.4723809	No significativa
SeniorCitizen	1.7228222	0.0000000	Significativa
Partner_d	0.3795771	0.0000000	Significativa
Dependents_d	0.4091528	0.0000000	Significativa
PaperlessBilling_d	2.0396864	0.0000000	Significativa
PhoneService_d	1.0537182	0.5154060	No significativa
MultipleLines_d	0.7930217	0.0000008	Significativa
OnlineSecurity_d	0.3152984	0.0000000	Significativa
OnlineBackup_d	0.4906618	0.0000000	Significativa
DeviceProtection_d	0.5218460	0.0000000	Significativa
TechSupport_d	0.3304390	0.0000000	Significativa
StreamingTV_d	0.9100727	0.0451068	Significativa
StreamingMovies_d	0.8980513	0.0222091	Significativa
InternetService_DSL	0.6124259	0.0000000	Significativa
InternetService_Fiber.optic	2.8271412	0.0000000	Significativa
InternetService_No	0.2451719	0.0000000	Significativa
Contract_Month.to.month	19.6007664	0.0000000	Significativa
Contract_One.year	0.2874121	0.0000000	Significativa
Contract_Two.year	0.0339392	0.0000000	Significativa
PaymentMethod_Bank.transfer..automatic.	0.4208072	0.0000000	Significativa
PaymentMethod_Credit.card..automatic.	0.3831120	0.0000000	Significativa
PaymentMethod_Electronic.check	3.4778884	0.0000000	Significativa
PaymentMethod_Mailed.check	0.9285194	0.2372410	No significativa
data_final.PaymentMethod_BankTransfer_CreditcCard	0.2860402	0.0000000	Significativa
MonthlyCharges	1.0062159	0.0000000	Significativa
TotalCharges	0.9994512	0.0000000	Significativa

Bajo la prueba para la significancia de cada una de las covariables por separado. Las variables que por separado resultaron significativas son: SeniorCitizen, Partner_d, Dependents_d, PaperlessBilling_d, MultipleLines_d, OnlineSecurity_d, OnlineBackup_d, DeviceProtection_d, TechSupport_d, StreamingTV_d, StreamingMovies_d, InternetService_DSL, InternetService_Fiber.optic, InternetService_No, Contract_Month.to.month, Contract_One.year, Contract_Two.year, PaymentMethod_BankTransfer_CreditcCard, PaymentMethod_Electronic.check, MonthlyCharges y Total Charges.

Notar que desde el análisis de covariables que afectan el tiempo de Vida habíamos concluido que ni Gender ni PhoneService tenían un impacto en el comportamiento del tiempo de vida.

Paso 2

Se ajusta un modelo con todas las variables que resultaron significativas en el paso 1 y se prueba la significancia de cada una de estas variables dado que las restantes ya estan consideradas en el modelo.

data.model.fit2 <- coxph(data_surv ~ SeniorCitizen+Partner_d+Dependents_d+PaperlessBilling_d+MultipleLines_d+OnlineSecurity_d+OnlineBackup_d+DeviceProtection_d+TechSupport_d+StreamingTV_d+StreamingMovies_d+InternetService_DSL+InternetService_Fiber.optic+Contract_One.year+Contract_Two.year+PaymentMethod_BankTransfer_CreditcCard+PaymentMethod_Electronic.check+MonthlyCharges+TotalCharges,
data = data_final, method = "breslow",na.action = na.exclude)



resumen2 <- summary(data.model.fit2)

resumdataframe2 <- as.data.frame(resumen2$coefficients)
kable(resumdataframe2[,c(2,3,5)])

	exp(coef)	se(coef)	Pr(>\|z\|)
SeniorCitizen	1.0321420	0.0566020	0.5762130
Partner_d	0.8445930	0.0549748	0.0021240
Dependents_d	0.9095310	0.0695836	0.1729562
PaperlessBilling_d	1.1540200	0.0565334	0.0112793
MultipleLines_d	0.9118988	0.0618366	0.1358431
OnlineSecurity_d	0.6791419	0.0737319	0.0000002
OnlineBackup_d	0.7918271	0.0591173	0.0000787
DeviceProtection_d	0.9101953	0.0587154	0.1090278
TechSupport_d	0.7763347	0.0719943	0.0004372
StreamingTV_d	0.9060152	0.0712314	0.1658649
StreamingMovies_d	0.9118841	0.0709020	0.1932641
InternetService_DSL	3.5175474	0.1643695	0.0000000
InternetService_Fiber.optic	3.6914367	0.2861507	0.0000050
Contract_One.year	0.2802938	0.1004965	0.0000000
Contract_Two.year	0.0249023	0.2009719	0.0000000
PaymentMethod_BankTransfer_CreditcCard	0.6063072	0.0755599	0.0000000
PaymentMethod_Electronic.check	0.8780176	0.0696267	0.0617100
MonthlyCharges	1.0512150	0.0052992	0.0000000
TotalCharges	0.9984666	0.0000397	0.0000000

Así, se descartan todas aquellas que aun cuando por si solas fueron significativas, ya no lo son al incluir otras covariables. De esta forma se retiran las covariables: SeniorCitizen, Dependents_d,MultipleLines_d, DeviceProtection_d, StreamingMovies_d, StreamingTV_d y PaymentMethod_Electronic.check.
Por lo que se hizo un nuevo análisis con las covariables vigentes.
Las variables vigentes son: Partner_d,PaperlessBilling_d,OnlineSecurity_d,OnlineBackup_d,TechSupport_d, InternetService_DSL,InternetService_Fiber.optic,Contract_One.year, Contract_Two.year, PaymentMethod_BankTransfer_CreditcCard, MonthlyCharges y TotalCharges.

data.model.fit3 <- coxph(data_surv ~ Partner_d+PaperlessBilling_d+OnlineSecurity_d+OnlineBackup_d+TechSupport_d+InternetService_DSL+InternetService_Fiber.optic+Contract_One.year+Contract_Two.year+PaymentMethod_BankTransfer_CreditcCard+MonthlyCharges+TotalCharges,
data = data_final, method = "breslow",na.action = na.exclude)



resumen3 <- summary(data.model.fit3)

resumdataframe3 <- as.data.frame(resumen3$coefficients)
kable(resumdataframe3[,c(2,3,5)])

	exp(coef)	se(coef)	Pr(>\|z\|)
Partner_d	0.8153549	0.0504891	0.0000528
PaperlessBilling_d	1.1404597	0.0558391	0.0185849
OnlineSecurity_d	0.7220278	0.0678078	0.0000016
OnlineBackup_d	0.8219791	0.0553865	0.0004009
TechSupport_d	0.8176351	0.0672654	0.0027606
InternetService_DSL	3.9649442	0.1479579	0.0000000
InternetService_Fiber.optic	5.4541312	0.2013722	0.0000000
Contract_One.year	0.2803912	0.0999100	0.0000000
Contract_Two.year	0.0250789	0.1999570	0.0000000
PaymentMethod_BankTransfer_CreditcCard	0.6642115	0.0556906	0.0000000
MonthlyCharges	1.0411924	0.0025955	0.0000000
TotalCharges	0.9984754	0.0000390	0.0000000

Todas las covariables vigentes resultaron significativas, es decir, todas resultaron significativas dado que las otras variables están incluidas en el modelo.

Paso 3

Todas las covariables que no se incluyeron en el paso 2, pero que fueron consideradas en el paso 1, tienen posibilidad de ser incluidas en el modelo, por lo que se hace un análisis por separado de las variables vigentes con cada una de ellas cuidando el detalle que si una es incluida no altere la significancia de las otras.

Se hizo un análisis para las 7 variables que resultaron significativas en el paso 1 pero no resultaron ser vigentes al final del paso 2.

data.model.fit3 <- coxph(data_surv ~ SeniorCitizen+Partner_d+PaperlessBilling_d+OnlineSecurity_d+OnlineBackup_d+TechSupport_d+InternetService_DSL+InternetService_Fiber.optic+Contract_One.year+Contract_Two.year+PaymentMethod_BankTransfer_CreditcCard+MonthlyCharges+TotalCharges,
data = data_final, method = "breslow",na.action = na.exclude)



resumen3 <- summary(data.model.fit3)

resumdataframe3 <- as.data.frame(resumen3$coefficients)
kable(resumdataframe3[,c(2,3,5)])

	exp(coef)	se(coef)	Pr(>\|z\|)
SeniorCitizen	1.0296304	0.0551229	0.5963030
Partner_d	0.8144684	0.0505263	0.0000487
PaperlessBilling_d	1.1375137	0.0560650	0.0215543
OnlineSecurity_d	0.7238939	0.0679846	0.0000020
OnlineBackup_d	0.8217588	0.0553951	0.0003944
TechSupport_d	0.8206574	0.0676427	0.0034783
InternetService_DSL	3.9467107	0.1481969	0.0000000
InternetService_Fiber.optic	5.4157053	0.2018112	0.0000000
Contract_One.year	0.2808951	0.0999896	0.0000000
Contract_Two.year	0.0251430	0.2000392	0.0000000
PaymentMethod_BankTransfer_CreditcCard	0.6649085	0.0557288	0.0000000
MonthlyCharges	1.0411867	0.0025953	0.0000000
TotalCharges	0.9984748	0.0000390	0.0000000

data.model.fit3 <- coxph(data_surv ~ Dependents_d+Partner_d+PaperlessBilling_d+OnlineSecurity_d+OnlineBackup_d+TechSupport_d+InternetService_DSL+InternetService_Fiber.optic+Contract_One.year+Contract_Two.year+PaymentMethod_BankTransfer_CreditcCard+MonthlyCharges+TotalCharges,
data = data_final, method = "breslow",na.action = na.exclude)



resumen3 <- summary(data.model.fit3)

resumdataframe3 <- as.data.frame(resumen3$coefficients)
kable(resumdataframe3[,c(2,3,5)])

	exp(coef)	se(coef)	Pr(>\|z\|)
Dependents_d	0.9183068	0.0679337	0.2096551
Partner_d	0.8369531	0.0544262	0.0010745
PaperlessBilling_d	1.1353198	0.0559662	0.0233476
OnlineSecurity_d	0.7245547	0.0678490	0.0000020
OnlineBackup_d	0.8233230	0.0553848	0.0004479
TechSupport_d	0.8195507	0.0673049	0.0031097
InternetService_DSL	3.9127944	0.1483117	0.0000000
InternetService_Fiber.optic	5.3527601	0.2018846	0.0000000
Contract_One.year	0.2821891	0.1000784	0.0000000
Contract_Two.year	0.0252765	0.2001246	0.0000000
PaymentMethod_BankTransfer_CreditcCard	0.6654040	0.0557090	0.0000000
MonthlyCharges	1.0412126	0.0025953	0.0000000
TotalCharges	0.9984754	0.0000389	0.0000000

data.model.fit3 <- coxph(data_surv ~ MultipleLines_d+Partner_d+PaperlessBilling_d+OnlineSecurity_d+OnlineBackup_d+TechSupport_d+InternetService_DSL+InternetService_Fiber.optic+Contract_One.year+Contract_Two.year+PaymentMethod_BankTransfer_CreditcCard+MonthlyCharges+TotalCharges,
data = data_final, method = "breslow",na.action = na.exclude)



resumen3 <- summary(data.model.fit3)

resumdataframe3 <- as.data.frame(resumen3$coefficients)
kable(resumdataframe3[,c(2,3,5)])

	exp(coef)	se(coef)	Pr(>\|z\|)
MultipleLines_d	0.9697619	0.0540185	0.5697560
Partner_d	0.8154872	0.0504901	0.0000535
PaperlessBilling_d	1.1413707	0.0558514	0.0179073
OnlineSecurity_d	0.7199982	0.0679805	0.0000013
OnlineBackup_d	0.8198993	0.0555639	0.0003518
TechSupport_d	0.8128270	0.0680542	0.0023255
InternetService_DSL	3.9006980	0.1506611	0.0000000
InternetService_Fiber.optic	5.3205099	0.2060278	0.0000000
Contract_One.year	0.2797191	0.0999471	0.0000000
Contract_Two.year	0.0250989	0.1998709	0.0000000
PaymentMethod_BankTransfer_CreditcCard	0.6646604	0.0557004	0.0000000
MonthlyCharges	1.0417045	0.0027362	0.0000000
TotalCharges	0.9984774	0.0000391	0.0000000

data.model.fit3 <- coxph(data_surv ~ DeviceProtection_d+Partner_d+PaperlessBilling_d+OnlineSecurity_d+OnlineBackup_d+TechSupport_d+InternetService_DSL+InternetService_Fiber.optic+Contract_One.year+Contract_Two.year+PaymentMethod_BankTransfer_CreditcCard+MonthlyCharges+TotalCharges,
data = data_final, method = "breslow",na.action = na.exclude)



resumen3 <- summary(data.model.fit3)

resumdataframe3 <- as.data.frame(resumen3$coefficients)
kable(resumdataframe3[,c(2,3,5)])

	exp(coef)	se(coef)	Pr(>\|z\|)
DeviceProtection_d	0.9431751	0.0560307	0.2964261
Partner_d	0.8166809	0.0505159	0.0000610
PaperlessBilling_d	1.1395442	0.0558471	0.0193337
OnlineSecurity_d	0.7170774	0.0681309	0.0000011
OnlineBackup_d	0.8198972	0.0554421	0.0003414
TechSupport_d	0.8166385	0.0673101	0.0026182
InternetService_DSL	3.9761531	0.1483307	0.0000000
InternetService_Fiber.optic	5.2982463	0.2036068	0.0000000
Contract_One.year	0.2822194	0.1001831	0.0000000
Contract_Two.year	0.0251774	0.2002020	0.0000000
PaymentMethod_BankTransfer_CreditcCard	0.6669761	0.0558295	0.0000000
MonthlyCharges	1.0421199	0.0027342	0.0000000
TotalCharges	0.9984756	0.0000390	0.0000000

data.model.fit3 <- coxph(data_surv ~ StreamingTV_d+Partner_d+PaperlessBilling_d+OnlineSecurity_d+OnlineBackup_d+TechSupport_d+InternetService_DSL+InternetService_Fiber.optic+Contract_One.year+Contract_Two.year+PaymentMethod_BankTransfer_CreditcCard+MonthlyCharges+TotalCharges,
data = data_final, method = "breslow",na.action = na.exclude)



resumen3 <- summary(data.model.fit3)

resumdataframe3 <- as.data.frame(resumen3$coefficients)
kable(resumdataframe3[,c(2,3,5)])

	exp(coef)	se(coef)	Pr(>\|z\|)
StreamingTV_d	0.9519683	0.0641313	0.4427589
Partner_d	0.8157021	0.0504976	0.0000548
PaperlessBilling_d	1.1442766	0.0560037	0.0161063
OnlineSecurity_d	0.7149245	0.0690357	0.0000012
OnlineBackup_d	0.8166252	0.0560319	0.0002999
TechSupport_d	0.8119477	0.0678864	0.0021503
InternetService_DSL	3.8939545	0.1501125	0.0000000
InternetService_Fiber.optic	5.0957920	0.2201402	0.0000000
Contract_One.year	0.2803128	0.0999547	0.0000000
Contract_Two.year	0.0250154	0.2000956	0.0000000
PaymentMethod_BankTransfer_CreditcCard	0.6627674	0.0557629	0.0000000
MonthlyCharges	1.0428580	0.0033293	0.0000000
TotalCharges	0.9984722	0.0000392	0.0000000

data.model.fit3 <- coxph(data_surv ~ StreamingMovies_d+Partner_d+PaperlessBilling_d+OnlineSecurity_d+OnlineBackup_d+TechSupport_d+InternetService_DSL+InternetService_Fiber.optic+Contract_One.year+Contract_Two.year+PaymentMethod_BankTransfer_CreditcCard+MonthlyCharges+TotalCharges,
data = data_final, method = "breslow",na.action = na.exclude)



resumen3 <- summary(data.model.fit3)

resumdataframe3 <- as.data.frame(resumen3$coefficients)
kable(resumdataframe3[,c(2,3,5)])

	exp(coef)	se(coef)	Pr(>\|z\|)
StreamingMovies_d	0.9579989	0.0636545	0.5002569
Partner_d	0.8151604	0.0504926	0.0000518
PaperlessBilling_d	1.1425020	0.0559054	0.0171739
OnlineSecurity_d	0.7156998	0.0690688	0.0000013
OnlineBackup_d	0.8163633	0.0563197	0.0003151
TechSupport_d	0.8122221	0.0679937	0.0022220
InternetService_DSL	3.9067490	0.1498343	0.0000000
InternetService_Fiber.optic	5.1426679	0.2195794	0.0000000
Contract_One.year	0.2798043	0.1000336	0.0000000
Contract_Two.year	0.0249797	0.2001997	0.0000000
PaymentMethod_BankTransfer_CreditcCard	0.6638143	0.0557004	0.0000000
MonthlyCharges	1.0426406	0.0033162	0.0000000
TotalCharges	0.9984731	0.0000392	0.0000000

data.model.fit3 <- coxph(data_surv ~ PaymentMethod_Electronic.check+Partner_d+PaperlessBilling_d+OnlineSecurity_d+OnlineBackup_d+TechSupport_d+InternetService_DSL+InternetService_Fiber.optic+Contract_One.year+Contract_Two.year+PaymentMethod_BankTransfer_CreditcCard+MonthlyCharges+TotalCharges,
data = data_final, method = "breslow",na.action = na.exclude)



resumen3 <- summary(data.model.fit3)

resumdataframe3 <- as.data.frame(resumen3$coefficients)
kable(resumdataframe3[,c(2,3,5)])

	exp(coef)	se(coef)	Pr(>\|z\|)
PaymentMethod_Electronic.check	0.8743115	0.0685703	0.0501311
Partner_d	0.8186098	0.0505324	0.0000747
PaperlessBilling_d	1.1500760	0.0559953	0.0125199
OnlineSecurity_d	0.7149624	0.0679915	0.0000008
OnlineBackup_d	0.8225182	0.0553883	0.0004194
TechSupport_d	0.8088102	0.0674753	0.0016625
InternetService_DSL	4.0312039	0.1480454	0.0000000
InternetService_Fiber.optic	5.5938522	0.2016408	0.0000000
Contract_One.year	0.2782587	0.0997816	0.0000000
Contract_Two.year	0.0247455	0.2000166	0.0000000
PaymentMethod_BankTransfer_CreditcCard	0.6006856	0.0752123	0.0000000
MonthlyCharges	1.0416366	0.0026048	0.0000000
TotalCharges	0.9984721	0.0000390	0.0000000

Ninguna de las 7 variables resultó ser significativa dado que las variables vigentes estaban incluidas en el modelo, por lo que se tiene una propuesta para el modelo final.

Paso 4

Las covariables propuestas para el modelo final son las siguientes. Cada una de las covariables resulta significativa.

data.model.fit3 <- coxph(data_surv ~ Partner_d+PaperlessBilling_d+OnlineSecurity_d+OnlineBackup_d+TechSupport_d+InternetService_DSL+InternetService_Fiber.optic+Contract_One.year+Contract_Two.year+PaymentMethod_BankTransfer_CreditcCard+MonthlyCharges+TotalCharges,
data = data_final, method = "breslow",na.action = na.exclude)



resumen3 <- summary(data.model.fit3)

resumdataframe3 <- as.data.frame(resumen3$coefficients)
kable(resumdataframe3[,c(2,3,5)])

	exp(coef)	se(coef)	Pr(>\|z\|)
Partner_d	0.8153549	0.0504891	0.0000528
PaperlessBilling_d	1.1404597	0.0558391	0.0185849
OnlineSecurity_d	0.7220278	0.0678078	0.0000016
OnlineBackup_d	0.8219791	0.0553865	0.0004009
TechSupport_d	0.8176351	0.0672654	0.0027606
InternetService_DSL	3.9649442	0.1479579	0.0000000
InternetService_Fiber.optic	5.4541312	0.2013722	0.0000000
Contract_One.year	0.2803912	0.0999100	0.0000000
Contract_Two.year	0.0250789	0.1999570	0.0000000
PaymentMethod_BankTransfer_CreditcCard	0.6642115	0.0556906	0.0000000
MonthlyCharges	1.0411924	0.0025955	0.0000000
TotalCharges	0.9984754	0.0000390	0.0000000

Validación del modelo

Riesgos Proporcionales

Se quiere verificar la proporcionalidad de todos los predictores en el modelo. Para esto se realiza una prueba para checar si existe correlación significativa entre los residuos y una transformación del tiempo (Ln(t)).

Se tiene una prueba de hipótesis por cada variable así como una prueba global, basadas cada una en una correlación entre los residuos asociados(Schoenfeld) a cada variable y el eje de tiempo (Ln(t)).

Para esta prueba un p-valor < 0.05 indica una violación del supuesto de proporcionalidad. En términos de pruebas de hipótesis:

cox.model.fit3 <- cox.zph(data.model.fit3)
cox.model.fit3

##                                           chisq df       p
## Partner_d                              1.05e+01  1  0.0012
## PaperlessBilling_d                     6.97e+01  1 < 2e-16
## OnlineSecurity_d                       2.57e+01  1 4.0e-07
## OnlineBackup_d                         1.09e+02  1 < 2e-16
## TechSupport_d                          5.84e+01  1 2.1e-14
## InternetService_DSL                    3.81e+02  1 < 2e-16
## InternetService_Fiber.optic            1.39e+03  1 < 2e-16
## Contract_One.year                      2.37e+00  1  0.1234
## Contract_Two.year                      1.70e-03  1  0.9672
## PaymentMethod_BankTransfer_CreditcCard 2.92e-02  1  0.8644
## MonthlyCharges                         2.89e+03  1 < 2e-16
## TotalCharges                           1.45e+03  1 < 2e-16
## GLOBAL                                 3.11e+03 12 < 2e-16

plot(cox.model.fit3 )

Como el p-valor de la prueba es menor a 0.05, rechazamos la hipótesis nula, así, el supuesto de riesgos proporcionales no se cumple.

Residuos Martingales

A menudo, asumimos que las covariables continuas tienen una forma lineal. Sin embargo, esta suposición debe verificarse.

Para verificar si cada variable debe incluirse en la forma lineal en el modelo se utilizan los residuos martingala. Una gráfica de los residuos martingala contra cada covariable (continua) debe mostrar una tendencia lineal. Asi que si se le ajusta un modelo, este debe mostrar una tendencia de linea recta.

par(mfrow=c(1, 2))

data.model.fit3.martingalas <- residuals(data.model.fit3, type = 'martingale')
X<-as.matrix(data_final[,c("MonthlyCharges", "TotalCharges")])
for (j in 1:2) {
        scatter.smooth(X[,j], data.model.fit3.martingalas,type="p", pch=".",xlab = c("MonthlyCharges", "TotalCharges")[j], ylab = "Residuos Martingalas")

}

Como las gráficas tienen forma de línea recta, no existe evidencia en contra de la linealidad.

Interpretación del modelo

Se compararán dos subpoblaciones definidas por valores de las covariables incluidas en el modelo final.

El modelo de Cox estimado es el siguiente

$h(t;X) =$ $h_0(t)$ exp(- 0.204131756Partner_d + 0.131431437PaperlessBilling_d- 0.325691569OnlineSecurity_d- 0.196040260OnlineBackup_d- 0.201339127TechSupport_d + 1.377491784InternetService_DSL + 1.696373348InternetService_Fiber - 1.271569639Contract_One.year - 3.685727093Contract_Two.year- 0.409154637PaymentMethod_BankTransfer_CreditcCard + 0.040366556MonthlyCharges - 0.001525796TotalCharges)

$X =$ (Partner_d, PaperlessBilling_d,OnlineSecurity_d,OnlineBackup_d,TechSupport_d,InternetService_DSL,InternetService_Fiber, Contract_One.year ,Contract_Two.year,PaymentMethod_BankTransfer_CreditcCard, MonthlyCharges, TotalCharges)

$X1 = (1,0,0,0,1,0,1,1,0,0,50,700)$

Grupo 1: El cliente es socio, no factura electronicamente, no tiene servicio de seguridad online ni un respaldo online, tiene soporte de tecnología, no tiene internet tipo DSL pero sí tiene fibra óptica, su contrato es a un año, no paga con tranferencia o tarjeta, paga al mes 50 y en cargos totales en el año pagó 700.

$X1 = (1,1,0,0,0,0,1,0,1,1,70,900)$

Grupo 2: El cliente es socio, sí factura electronicamente, no tiene servicio de seguridad online ni un respaldo online, tampoco soporte de tecnología, no tiene internet tipo DSL pero sí tiene fibra óptica, su contrato es a dos añoS, paga con transferencia o tarjeta ,paga al mes 70 y en cargos totales en el año pagó 900.

exp(- 0.204131756*1 + 0.131431437*0-  0.325691569*0- 0.196040260*0- 0.201339127*1 +  1.377491784*0 +  1.696373348*1 - 1.271569639*1 - 3.685727093*0- 0.409154637*0+  0.040366556*50 - 0.001525796*700)/exp(- 0.204131756*1 + 0.131431437*1-  0.325691569*- 0.196040260*0- 0.201339127*0 +  1.377491784*0 +  1.696373348*1 - 1.271569639*0 - 3.685727093*1- 0.409154637*1+  0.040366556*70 - 0.001525796*900)

## [1] 7.303616

\[\frac{h(t;X1)}{h(t;X2)} = 7.3>1 \] El grupo 1 tiene mayor riesgo que el grupo dos, de hecho el riesgo en un tiempo t para el grupo 1 es 7.3 veces el riesgo del grupo 2. Se observa que son muy diferentes las funciones de riesgo. La probabilidad de que una persona abandone la compañía del grupo 1 sea después de un tiempo t, es menor a que la probabilidad de que una persona del grupo 2 abandone después del tiempo t.

Proyecto de Análisis de Supervivencia

Emiliano Caballero

03/02/2021